000100*AAAABBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBCCCCCCCC
000200*                      
000300*                    (SEQ)                        (SEQ)                  
000400 IDENTIFICATION DIVISION.
000500 PROGRAM-ID.                 DYNTEST1.
000600*AUTHOR.                     KENJI KIMURA.
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000*                        
001100*ACMFILE
001200*ACMRECNAME=I-RECORD
001300 SELECT INP-FILE ASSIGN TO "dbtests2"
001400        ORGANIZATION IS INDEXED
001500        ACCESS MODE  IS DYNAMIC
001600        RECORD KEY   IS I-ID.
001700 DATA DIVISION.
001800 FILE SECTION.
001900*                    
002000 FD  INP-FILE.
002100 COPY "I_RECORD2.cbl".
002200 WORKING-STORAGE SECTION.
002300 01  SOME-AREA.
002400     05  I-COUNTER           PIC 9(05).
002500     05  O-COUNTER           PIC 9(05).
002600     05  END-FLG             PIC 9(01)  VALUE  ZERO.
002700     05  DSP-PROC            PIC 9(01)  VALUE  ZERO.
002800     05  WRK-FUDOU           PIC S9(07).
002900*
003000 COPY "SCR_RECORD.cbl".
003100*        
003200*SCREEN SECTION.
003300*
003400*COPY "DSP_RECORD.cbl".
003500*
003600 PROCEDURE DIVISION.
003700*              
003800 MAIN SECTION.
003900     PERFORM   INIT.
004000     PERFORM   FL-OPEN.
004100*                                                      
004200     PERFORM   UNTIL  END-FLG  NOT  =  ZERO
004300        DISPLAY   "PROC?"
004400        ACCEPT    DSP-PROC   
004500        EVALUATE  DSP-PROC
004600        WHEN  0
004700*                 
004800            MOVE  1  TO  END-FLG
004900        WHEN  1
005000*                 
005100            DISPLAY  SCR-RECORD
005200            ACCEPT   SCR-RECORD
005300            PERFORM  OUT-WRITE
005400        WHEN  2
005500*                       
005600            DISPLAY  SCR-RECORD
005700            ACCEPT    SCR-RECORD
005800            PERFORM  INP-READ             
005900            DISPLAY  SCR-RECORD
006000        WHEN  3
006100*                   
006200            DISPLAY  SCR-RECORD
006300            ACCEPT   SCR-RECORD
006400            PERFORM  OUT-REWRITE
006500        WHEN  9
006600*                 
006700            DISPLAY  SCR-RECORD
006800            ACCEPT   SCR-RECORD
006900            PERFORM  OUT-DELETE
007000        END-EVALUATE
007100     END-PERFORM.
007200     PERFORM   FL-CLOSE.
007300     PERFORM   TERM.
007400     STOP RUN.
007500*              
007600 INIT SECTION.
007700     DISPLAY   "PROGRAM STARTING.".
007800     EXIT.
007900*                      
008000 FL-OPEN SECTION.
008100     OPEN   I-O  INP-FILE.
008200     EXIT.
008300*                  
008400 INP-READ SECTION.
008500     MOVE SCR-ID  TO  I-ID.
008600     READ INP-FILE 
008700     INVALID KEY
008800         DISPLAY  "CANT FIND"
008900         MOVE  1  TO  END-FLG
009000     END-READ.
009100     IF  END-FLG  =  ZERO
009200*                                                                
009300         ADD  1              TO  I-COUNTER
009400         PERFORM REC2SCR
009500     END-IF.
009600     EXIT.
009700*                  
009800 OUT-WRITE SECTION.
009900     PERFORM SCR2REC.
010000     WRITE I-RECORD
010100     INVALID KEY
010200         MOVE  1  TO  END-FLG
010300     NOT INVALID KEY
010400         INITIALIZE   SCR-RECORD
010500     END-WRITE.
010600     ADD  1                  TO  O-COUNTER.
010700     EXIT.
010800*                  
010900 OUT-REWRITE SECTION.
011000     PERFORM SCR2REC.
011100     REWRITE I-RECORD
011200     INVALID  KEY
011300         MOVE  1  TO  END-FLG
011400     NOT INVALID KEY
011500         INITIALIZE   SCR-RECORD
011600     END-REWRITE.
011700     ADD  1                  TO  O-COUNTER.
011800     EXIT.
011900*                  
012000 OUT-DELETE SECTION.
012100     PERFORM SCR2REC.
012200     DELETE INP-FILE
012300     INVALID  KEY
012400         MOVE  1  TO  END-FLG
012500     NOT INVALID KEY
012600         INITIALIZE   SCR-RECORD
012700     END-DELETE.
012800     ADD  1                  TO  O-COUNTER.
012900     EXIT.
013000*                      
013100 REC2SCR SECTION.
013200     INITIALIZE              SCR-RECORD.
013300     MOVE I-ID            TO SCR-ID.
013400     MOVE I-CD            TO SCR-CD.
013500     MOVE I-NIHONGO       TO SCR-NIHONGO.
013600*    MOVE I-SEISU         TO SCR-SEISU.
013700     IF  I-SEISU  >  ZERO
013800         MOVE I-SEISU     TO SCR-SEISU
013900         MOVE ZERO        TO SCR-SEISU-FLG
014000     ELSE
014100         COMPUTE SCR-SEISU = I-SEISU * (-1)
014200         MOVE    1        TO SCR-SEISU-FLG
014300     END-IF
014400     MOVE I-HIZUKE-YYYY   TO SCR-HIZUKE-YYYY.
014500     MOVE I-HIZUKE-MM     TO SCR-HIZUKE-MM.
014600     MOVE I-HIZUKE-DD     TO SCR-HIZUKE-DD.
014700     MOVE I-JIKOKU-HH     TO SCR-JIKOKU-HH.
014800     MOVE I-JIKOKU-MM     TO SCR-JIKOKU-MM.
014900     MOVE I-JIKOKU-SS     TO SCR-JIKOKU-SS.
015000*    MOVE I-FUDOU         TO SCR-FUDOU.
015100     IF  I-FUDOU  >  ZERO
015200         COMPUTE WRK-FUDOU = I-FUDOU *   1000
015300         MOVE ZERO        TO SCR-FUDOU-FLG
015400     ELSE
015500         COMPUTE WRK-FUDOU = I-FUDOU * (-1000)
015600         MOVE    1        TO SCR-FUDOU-FLG
015700     END-IF.
015800     MOVE  WRK-FUDOU(1:4) TO SCR-FUDOU1.
015900     MOVE  WRK-FUDOU(5:3) TO SCR-FUDOU2.
016000     EXIT.
016100*                      
016200 SCR2REC SECTION.
016300     MOVE SCR-ID          TO I-ID.
016400     MOVE SCR-CD          TO I-CD.
016500     MOVE SCR-NIHONGO     TO I-NIHONGO.
016600*    MOVE SCR-SEISU       TO I-SEISU.
016700     IF  SCR-SEISU-FLG  = ZERO
016800         MOVE SCR-SEISU       TO I-SEISU
016900     ELSE
017000         COMPUTE  I-SEISU  = SCR-SEISU * (-1)
017100     END-IF
017200     MOVE SCR-HIZUKE-YYYY TO I-HIZUKE-YYYY.
017300     MOVE SCR-HIZUKE-MM   TO I-HIZUKE-MM.
017400     MOVE SCR-HIZUKE-DD   TO I-HIZUKE-DD.
017500     MOVE SCR-JIKOKU-HH   TO I-JIKOKU-HH.
017600     MOVE SCR-JIKOKU-MM   TO I-JIKOKU-MM.
017700     MOVE SCR-JIKOKU-SS   TO I-JIKOKU-SS.
017800*    MOVE SCR-FUDOU       TO I-FUDOU.
017900     COMPUTE  WRK-FUDOU   =  SCR-FUDOU1  *  1000
018000                          +  SCR-FUDOU2.
018100     IF   SCR-FUDOU-FLG   NOT  =  ZERO
018200          COMPUTE  I-FUDOU = WRK-FUDOU   /  (-1000)
018300     ELSE
018400          COMPUTE  I-FUDOU = WRK-FUDOU   /    1000
018500     END-IF.
018600     EXIT.
018700*                              
018800 FL-CLOSE SECTION.
018900     CLOSE  INP-FILE.
019000     EXIT.
019100*              
019200 TERM SECTION.
019300     DISPLAY   "PROGRAM NORMALLY TERMINATED.".
019400     DISPLAY   "INPUT-COUNT:" I-COUNTER.
019500     DISPLAY   "OUTPUT-COUNT:" O-COUNTER.
019600     EXIT.
019700
